home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 7: Sunsite / Linux Cubed Series 7 - Sunsite Vol 1.iso / system / printing / ljetmgr2.4-b / ljetmgr2 / SW / lib / libtxOption5.2.tsl < prev    next >
Text File  |  1996-06-14  |  4KB  |  96 lines
  1. # RQ tclkit 3
  2. # RQ txLabel 5
  3. # RQ font 2
  4. # +END
  5. # RCS:    $Id: option.tcl,v 1.2 1996/05/12 14:52:39 risc Exp $
  6. Require txLabel 5
  7. proc txOption_Init { args } {Require font 2
  8. option add *unit.font [Font get Label] widgetDefault
  9. option add *Menubutton*highlightThickness [Cfg get Tx HilitBorder] widgetDefault
  10. option add *Menubutton*font [Font get Menu]  widgetDefault
  11. option add *Menu*background [Cfg get Color MenuBack] widgetDefault
  12. option add *Menu*disabledForeground [Cfg get Color MenuDisabledFore]  widgetDefault
  13. option add *Menu*foreground [Cfg get Color MenuFore]
  14. option add *Menu*font [Font get Menu]  widgetDefault
  15. option add *Menubutton*selectColor [Cfg get Color MenuSelect] widgetDefault}
  16. tixWidgetClass txOption {-classname TxOption
  17. -superclass txLabel
  18. -method {add
  19. set
  20. get
  21. setname
  22. getname}
  23. -flag {-command
  24. -state
  25. -unit
  26. -unitwidth
  27. -modified}
  28. -forcecall {-variable 
  29. -state}
  30. -configspec {{-command command Command {}}
  31. {-disablecallback disableCallback DisableCallback false}
  32. {-state state State normal}
  33. {-unit unit Unit ""}            
  34. {-unitwidth unitWidth UnitWidth 0}            
  35. {-variable variable Variable ""}
  36. {-modified modified Modified 0}      
  37. {-width width Width 10}}}
  38. proc txOption::InitWidgetRec {w} {upvar #0 $w data
  39. tixChainMethod $w InitWidgetRec
  40. set data(nItems)    0
  41. set data(varInited)      0
  42. set data(value) ""}
  43. proc txOption::ConstructWidget {w} {upvar \#0 $w data
  44. tixChainMethod $w ConstructWidget
  45. set data(w:menubutton) [menubutton $w.menubutton -indicatoron 1 -width $data(-width) -relief raised -borderwidth 2 -takefocus 1 ]
  46. set data(w:menu) [menu $w.menubutton.menu -tearoff 0 ]
  47. $data(w:menubutton) config -menu $data(w:menu)
  48. grid $data(w:menubutton) -row 1 -column 1 -sticky ew
  49. grid columnconfigure $w 1 -weight 100
  50. grid rowconfigure $w 1 -weight 100
  51. set data(w:unit) [label $w.unit -text $data(-unit) -width $data(-unitwidth) -anchor w ]
  52. if { $data(-unit)!="" } {grid $data(w:unit) -row 1 -column 2 -sticky we
  53. grid columnconfigure $w 2 -weight 0}}
  54. proc txOption::SetBindings {w} {upvar #0 $w data
  55. tixChainMethod $w SetBindings
  56. bindtags $data(w:menubutton) [concat $data(ClassName) [bindtags $data(w:menubutton)] ]
  57. bind $data(w:menubutton) <Up>   [bind Menubutton <space>]
  58. bind $data(w:menubutton) <Down> [bind Menubutton <space>]}
  59. proc txOption::config-state {w state} {upvar #0 $w data
  60. $data(w:menubutton) config -state $state}
  61. proc txOption::config-width {w wid} {upvar #0 $w data
  62. $data(w:menubutton) config -width $wid}
  63. proc txOption::add {w name args} {upvar #0 $w data
  64. if [info exists data($name,index)] {error "item $name already exists in the option menu $w"}
  65. set validOptions {-command -label}
  66. set opt(-command)        {}
  67. set opt(-label)        $name
  68. tixHandleOptions -nounknown  opt $validOptions $args
  69. if {$opt(-command)    != {}} {error "option -command cannot be specified"}
  70. eval $data(w:menu) add command $args [list -label $opt(-label) -command "txOption::invoke $w \{$name\}"]
  71. set index $data(nItems)
  72. set data($index,name) $name
  73. set data($name,label) $opt(-label)
  74. set data($name,index) $index
  75. if {$index == 0} {$data(w:menubutton) config -text $data($name,label)
  76. set data(value) $name
  77. set mod $data(-modified)
  78. txOption::invoke $w $name
  79. set data(-modified) $mod}
  80. incr data(nItems)}
  81. proc txOption::set {w name} {upvar #0 $w data
  82. set label $data($name,label)
  83. if { $label=={} } {set label $name}
  84. $data(w:menubutton) config -text $label
  85. set data(value) $name}
  86. proc txOption::get { w } {upvar #0 $w data
  87. return $data(value)}
  88. proc txOption::invoke {w name} {upvar #0 $w data
  89. if { $data(-state) == "normal"} {set data(-modified) 1
  90. if [info exists data($name,index)] {$data(w:menubutton) config -text $data($name,label)
  91. set data(value) $name
  92. if {$data(-command) != {} } {Require tclkit 3
  93. set cmd [Replace $data(-command) [list "%i=$data($name,index)" "%n=$name" "%t=$data($name,label)" "%w=$w" "%e=$data(w:menubutton)" ]]
  94. eval $cmd}} else {error "item '$name' does not exist"}}}
  95. # +EOF
  96.